home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol117 / updatper.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-12-15  |  11.3 KB  |  439 lines
  1. 90  WIDTH "scrn:", 80
  2. 95  SCREEN 0,1,0,0
  3. 100  TITLE$ = "Update the Persons File Program"
  4. 105  TITLE$ = TITLE$ + " ON DISPLAY"
  5. 110  VERSION$ = "Version 3.0"
  6. 115  COPY1$ = "Copyright (c) 1983, 1984, 1985, by:"
  7. 120  COPY2$ = "Melvin O. Duke"
  8. 125  PRICE$ = "$35"
  9. 130  ADDR1$ = "Melvin O. Duke"
  10. 135  ADDR2$ = "P. O. Box 20836"
  11. 140  ADDR3$ = "San Jose, CA  95160"
  12. 145  REM Dimension Statements go here
  13. 170  REM Produce the first screen
  14. 175  KEY OFF : CLS
  15. 180  REM Draw the outer double box
  16. 185  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 400
  17. 190  REM Find the title location
  18. 195  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  19. 200  REM Draw the title box
  20. 205  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 600
  21. 210  REM Print the title
  22. 215  LOCATE 4,TITLE.POS : PRINT TITLE$
  23. 220  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  24. 225  REM Draw the Contribution box
  25. 230  R1 = 8 : C1 = 19 : R2 = 17 : C2 = 62 : GOSUB 400
  26. 235  REM Request the Contribution
  27. 240  LOCATE 9,23 : PRINT "If you are using these programs, and"
  28. 245  LOCATE 10,21 : PRINT "finding them of value, your contribution"
  29. 250  LOCATE 11,23 : PRINT "("+PRICE$+" suggested) will be anticipated."
  30. 255  REM Draw the Mailing Label
  31. 260  R1 = 12 : C1 = 28 : R2 = 16 : C2 = 52 : GOSUB 600
  32. 265  REM Print the Name and Address
  33. 270  LOCATE 13,40-INT(LEN(ADDR1$)/2) :  PRINT ADDR1$;
  34. 275  LOCATE 14,40-INT(LEN(ADDR2$)/2) :  PRINT ADDR2$;
  35. 280  LOCATE 15,40-INT(LEN(ADDR3$)/2) :  PRINT ADDR3$;
  36. 285  REM Draw the Copyright box
  37. 290  R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 400
  38. 295  REM Print the Copyright
  39. 300  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  40. 305  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  41. 310  GOTO 740
  42. 400  REM subroutine to print a double box
  43. 405  COLOR 5
  44. 410  FOR I = R1 + 1 TO R2 - 1
  45. 420   LOCATE I, C1 : PRINT CHR$(186);
  46. 430   LOCATE I, C2 : PRINT CHR$(186);
  47. 440  NEXT I
  48. 450  FOR J = C1 + 1 TO C2 - 1
  49. 460   LOCATE R1, J : PRINT CHR$(205);
  50. 470   LOCATE R2, J : PRINT CHR$(205);
  51. 480  NEXT J
  52. 490   LOCATE R1, C1 : PRINT CHR$(201);
  53. 500   LOCATE R1, C2 : PRINT CHR$(187);
  54. 510   LOCATE R2, C1 : PRINT CHR$(200);
  55. 520   LOCATE R2, C2 : PRINT CHR$(188);
  56. 525  COLOR 7
  57. 530  RETURN
  58. 600  REM subroutine to print a single box
  59. 605  COLOR 3
  60. 610  FOR I = R1 + 1 TO R2 - 1
  61. 620   LOCATE I, C1 : PRINT CHR$(179);
  62. 630   LOCATE I, C2 : PRINT CHR$(179);
  63. 640  NEXT I
  64. 650  FOR J = C1 + 1 TO C2 - 1
  65. 660   LOCATE R1, J : PRINT CHR$(196);
  66. 670   LOCATE R2, J : PRINT CHR$(196);
  67. 680  NEXT J
  68. 690   LOCATE R1, C1 : PRINT CHR$(218);
  69. 700   LOCATE R1, C2 : PRINT CHR$(191);
  70. 710   LOCATE R2, C1 : PRINT CHR$(192);
  71. 720   LOCATE R2, C2 : PRINT CHR$(217);
  72. 725  COLOR 7
  73. 730  RETURN
  74. 740  REM ask user to press a key to continue
  75. 750  LOCATE 25,1
  76. 760  PRINT "Have Data Diskette(s) in Place, then Press any key to continue.";
  77. 770  K$ = INKEY$ : IF K$ = "" THEN 770
  78. 780  CLS
  79. 840  CLS
  80. 1000  REM Update the Persons File Program.
  81. 1010  REM By:  Melvin O. Duke.  Last Updated:  24 December 1984.
  82. 1020  OPEN "a:persfile" AS #1 LEN = 256
  83. 1030  FIELD 1, 5 AS F1$, 20 AS F2$, 30 AS F3$, 2 AS F4$, 5 AS F5$, 5 AS F6$, 5 AS F7$, 11 AS F8$, 18 AS F9$, 16 AS F10$, 16 AS F11$, 11 AS F12$, 18 AS F13$, 16 AS F14$, 16 AS F15$, 11 AS F16$, 18 AS F17$, 16 AS F18$, 16 AS F19$
  84. 1040  REM ask the user for input
  85. 1045  LOCATE 23,1 : PRINT SPACE$(79);
  86. 1050  LOCATE 23,1 : PRINT "(0 to quit, ? to locate unused record)";
  87. 1060  LOCATE 22,1 : PRINT SPACE$(79) : LOCATE 22,1
  88. 1070  INPUT "Enter Record Number of Person to Update"; REPLY$
  89. 1071  IF REPLY$ <> "?" THEN 1088
  90. 1072  REM Locate an unused record
  91. 1073  FOUND = 0 : IF REC.NO = 0 THEN REC.NO = 1
  92. 1074  FOR LOOK = REC.NO TO 500
  93. 1075   GET #1, LOOK
  94. 1076   LOCATE 15,1 : PRINT "Searching Record";LOOK;
  95. 1077   T1 = CVS(F1$)
  96. 1078   IF T1 > 0 THEN 1080
  97. 1079   FOUND = 1 : REC.NO = LOOK : LOOK = 500
  98. 1080  NEXT LOOK
  99. 1081  IF FOUND = 1 THEN 1110
  100. 1082  PRINT "Unable to find an unused record above record";REC.NO
  101. 1083  PRINT "Either start from record 1 or extend the file"
  102. 1084  PRINT "Press any key to continue"
  103. 1085  A$ = INKEY$ : IF A$ = "" THEN 1085
  104. 1086  GOTO 1040
  105. 1088  REC.NO = VAL(REPLY$)
  106. 1089  IF REC.NO = 0 THEN 4080
  107. 1090  IF REC.NO < 1 OR REC.NO > 500 THEN 1040
  108. 1100  GET #1, REC.NO
  109. 1110  REM Extract information from the file for use
  110. 1120  T1 = CVS(F1$)
  111. 1130  T2$ = F2$
  112. 1140  T3$ = F3$
  113. 1150  FOR J = 1 TO LEN(F3$)-1
  114. 1160   IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
  115. 1170  NEXT J
  116. 1180  T4$ = F4$
  117. 1190  IF LEFT$(T4$,1) = "M" THEN T4$ = "Male"
  118. 1200  IF LEFT$(T4$,1) = "F" THEN T4$ = "Female"
  119. 1210  T5 = CVS(F5$)
  120. 1220  T6 = CVS(F6$)
  121. 1230  T7 = CVS(F7$)
  122. 1240  T8$ = F8$
  123. 1250  T9$ = F9$
  124. 1260  T10$ = F10$
  125. 1270  T11$ = F11$
  126. 1280  T12$ = F12$
  127. 1290  T13$ = F13$
  128. 1300  T14$ = F14$
  129. 1310  T15$ = F15$
  130. 1320  T16$ = F16$
  131. 1330  T17$ = F17$
  132. 1340  T18$ = F18$
  133. 1350  T19$ = F19$
  134. 1360  CLS
  135. 1370  R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 400  'Double box
  136. 1380  R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 2100  'Horizontal double
  137. 1390  LOCATE 2,3 : PRINT "Personal Information for:"
  138. 1400  R1 = 3 : C1 = 40 : R2 = 21 : C2 = 40 : GOSUB 2240  'Vertical Double
  139. 1410  LOCATE 4,3 : COLOR 1 : PRINT "Person:"; : COLOR 6
  140. 1420  LOCATE 6,3 : PRINT "Record-Number:";
  141. 1430  LOCATE 8,3 : PRINT "Surname:";
  142. 1440  LOCATE 9,3 : PRINT "Given-names:";
  143. 1450  LOCATE 11,3 : PRINT "Sex:";
  144. 1460  LOCATE 12,3 : PRINT "Code:";
  145. 1470  R1 = 13 : C1 = 1 : R2 =13 : C2 = 40 : GOSUB 2100  'Horizontal Double
  146. 1480  LOCATE 14,3 : COLOR 1 : PRINT "Person's Father:"; : COLOR 6
  147. 1490  LOCATE 16,3 : PRINT "Father's Record-number:";
  148. 1500  R1 = 17 : C1 = 1 : R2 = 17 : C2 = 40 : GOSUB 2170  'Horizontal Single
  149. 1510  LOCATE 18,3 : COLOR 1 : PRINT "Person's Mother:"; : COLOR 6
  150. 1520  LOCATE 20,3 : PRINT "Mother's Record-number:";
  151. 1530  LOCATE 4,42 : COLOR 1 : PRINT "Person's Vital Statistics:"; : COLOR 6
  152. 1540  LOCATE 6,42 : PRINT "Birth-date:";
  153. 1550  LOCATE 7,42 : PRINT "Birth-city:";
  154. 1560  LOCATE 8,42 : PRINT "Birth-county:";
  155. 1570  LOCATE 9,42 : PRINT "State/Country:";
  156. 1580  LOCATE 11,42 : PRINT "Death-date:";
  157. 1590  LOCATE 12,42 : PRINT "Death-city:";
  158. 1600  LOCATE 13,42 : PRINT "Death-county:";
  159. 1610  LOCATE 14,42 : PRINT "State/Country:";
  160. 1620  LOCATE 16,42 : PRINT "Burial-date:";
  161. 1630  LOCATE 17,42 : PRINT "Burial-city:";
  162. 1640  LOCATE 18,42 : PRINT "Burial-county:";
  163. 1650  LOCATE 19,42 : PRINT "State/Country:";
  164. 1660  GOSUB 1680 'To print the current information
  165. 1670  GOTO 2380 'For User Input
  166. 1680  REM Print the Information Currently Present
  167. 1690  LOCATE 2,29 : PRINT SPACE$(50);
  168. 1700  LOCATE 2,29 : COLOR 7 : PRINT T3$ + " " + T2$;
  169. 1710  LOCATE 6,18 : PRINT SPACE$(5);
  170. 1720  LOCATE 6,18 : COLOR 2 : PRINT T1;
  171. 1730  LOCATE 8,18 : PRINT SPACE$(20);
  172. 1740  LOCATE 8,18 : PRINT T2$;
  173. 1750  LOCATE 9,18 : PRINT SPACE$(22);
  174. 1760  LOCATE 9,18 : PRINT T3$;
  175. 1770  LOCATE 11,18 : PRINT SPACE$(7);
  176. 1780  LOCATE 11,18 : PRINT T4$;
  177. 1790  LOCATE 12,9 : PRINT SPACE$(5);
  178. 1800  LOCATE 12,9 : PRINT T5;
  179. 1810  LOCATE 16,27 : PRINT SPACE$(5);
  180. 1820  LOCATE 16,27 : PRINT T6;
  181. 1830  LOCATE 20,27 : PRINT SPACE$(5);
  182. 1840  LOCATE 20,27 : PRINT T7;
  183. 1850  LOCATE 6,57 : PRINT SPACE$(11);
  184. 1860  LOCATE 6,57 : PRINT T8$;
  185. 1870  LOCATE 7,57 : PRINT SPACE$(18);
  186. 1880  LOCATE 7,57 : PRINT T9$;
  187. 1890  LOCATE 8,57 : PRINT SPACE$(16);
  188. 1900  LOCATE 8,57 : PRINT T10$;
  189. 1910  LOCATE 9,57 : PRINT SPACE$(16);
  190. 1920  LOCATE 9,57 : PRINT T11$;
  191. 1930  LOCATE 11,57 : PRINT SPACE$(11);
  192. 1940  LOCATE 11,57 : PRINT T12$;
  193. 1950  LOCATE 12,57 : PRINT SPACE$(18);
  194. 1960  LOCATE 12,57 : PRINT T13$;
  195. 1970  LOCATE 13,57 : PRINT SPACE$(16);
  196. 1980  LOCATE 13,57 : PRINT T14$;
  197. 1990  LOCATE 14,57 : PRINT SPACE$(16);
  198. 2000  LOCATE 14,57 : PRINT T15$;
  199. 2010  LOCATE 16,57 : PRINT SPACE$(11);
  200. 2020  LOCATE 16,57 : PRINT T16$;
  201. 2030  LOCATE 17,57 : PRINT SPACE$(18);
  202. 2040  LOCATE 17,57 : PRINT T17$;
  203. 2050  LOCATE 18,57 : PRINT SPACE$(16);
  204. 2060  LOCATE 18,57 : PRINT T18$;
  205. 2070  LOCATE 19,57 : PRINT SPACE$(16);
  206. 2080  LOCATE 19,57 : PRINT T19$; : COLOR 7
  207. 2090  RETURN
  208. 2100  REM Subroutine to draw a double horizontal line.  Attach to double.
  209. 2105  COLOR 5
  210. 2110  FOR J = C1 + 1 TO C2 - 1
  211. 2120   LOCATE R1,J : PRINT CHR$(205);
  212. 2130  NEXT J
  213. 2140  LOCATE R1,C1 : PRINT CHR$(204);
  214. 2150  LOCATE R1,C2 : PRINT CHR$(185);
  215. 2155  COLOR 7
  216. 2160  RETURN
  217. 2170  REM Subroutine to draw a single horizontal line.  Attach to double.
  218. 2175  COLOR 5
  219. 2180  FOR J = C1 + 1 TO C2 - 1
  220. 2190   LOCATE R1,J : PRINT CHR$(196);
  221. 2200  NEXT J
  222. 2210  LOCATE R1,C1 : PRINT CHR$(199);
  223. 2220  LOCATE R1,C2 : PRINT CHR$(182);
  224. 2225  COLOR 7
  225. 2230  RETURN
  226. 2240  REM Subroutine to draw a double vertical line.  Attach to double.
  227. 2245  COLOR 5
  228. 2250  FOR I = R1 + 1 TO R2 - 1
  229. 2260   LOCATE I,C1 : PRINT CHR$(186);
  230. 2270  NEXT I
  231. 2280  LOCATE R1,C1 : PRINT CHR$(203);
  232. 2290  LOCATE R2,C1 : PRINT CHR$(202);
  233. 2295  COLOR 7
  234. 2300  RETURN
  235. 2310  REM Subroutine to draw a single vertical line.  Attach to double.
  236. 2315  COLOR 5
  237. 2320  FOR I = R1 + 1 TO R2 - 1
  238. 2330   LOCATE I,C1 : PRINT CHR$(179);
  239. 2340  NEXT I
  240. 2350  LOCATE R1,C1 : PRINT CHR$(209);
  241. 2360  LOCATE R2,C1 : PRINT CHR$(207);
  242. 2365  COLOR 7
  243. 2370  RETURN
  244. 2380  REM Routines to Obtain information from the User
  245. 2390  LOCATE 24,1 : PRINT "('enter' to leave alone, '/ enter' to end record, or reply as shown.)";
  246. 2400  LOCATE 23,1
  247. 2410  INPUT "Enter the Record Number";REPLY$
  248. 2420  IF REPLY$ = "/" THEN 3750
  249. 2430  IF REPLY$ = "" THEN 2470
  250. 2440  IF ABS(VAL(REPLY$)) = ABS(T1) THEN 2450 ELSE 2460
  251. 2450  T1 = VAL(REPLY$)
  252. 2452  IF T1 < 1 THEN GOSUB 5000 : GOSUB 1680 : GOTO 3750  'Negative
  253. 2460  GOSUB 1680
  254. 2470  LOCATE 23,1 : PRINT SPACE$(79);
  255. 2480  LOCATE 23,1
  256. 2490  INPUT "Enter the Person's Surname (all capital letters)";REPLY$
  257. 2500  IF REPLY$ = "/" THEN 3750
  258. 2510  IF REPLY$ = "" THEN 2540
  259. 2520  T2$ = REPLY$
  260. 2530  GOSUB 1680
  261. 2540  LOCATE 23,1 : PRINT SPACE$(79);
  262. 2550  LOCATE 23,1
  263. 2560  INPUT "Enter the Person's Given Names";REPLY$
  264. 2570  IF REPLY$ = "/" THEN 3750
  265. 2580  IF REPLY$ = "" THEN 2610
  266. 2590  T3$ = REPLY$
  267. 2600  GOSUB 1680
  268. 2610  LOCATE 23,1 : PRINT SPACE$(79);
  269. 2620  LOCATE 23,1
  270. 2630  INPUT "Enter the Person's Sex";REPLY$
  271. 2640  IF REPLY$ = "/" THEN 3750
  272. 2650  IF REPLY$ = "" THEN 2700
  273. 2660  T4$ = REPLY$
  274. 2670  IF LEFT$(REPLY$,1) = "m" OR LEFT$(REPLY$,1) = "M" THEN T4$ = "Male"
  275. 2680  IF LEFT$(REPLY$,1) = "f" OR LEFT$(REPLY$,1) = "F" THEN T4$ = "Female"
  276. 2690  GOSUB 1680
  277. 2700  LOCATE 23,1 : PRINT SPACE$(79);
  278. 2710  LOCATE 23,1
  279. 2720  INPUT "Enter the Person's Code";REPLY$
  280. 2730  IF REPLY$ = "/" THEN 3750
  281. 2740  IF REPLY$ = "" THEN 2770
  282. 2750  T5 = VAL(REPLY$)
  283. 2760  GOSUB 1680
  284. 2770  LOCATE 23,1 : PRINT SPACE$(79);
  285. 2780  LOCATE 23,1
  286. 2790  INPUT "Enter the Father's Record Number";REPLY$
  287. 2800  IF REPLY$ = "/" THEN 3750
  288. 2810  IF REPLY$ = "" THEN 2840
  289. 2820  T6 = VAL(REPLY$)
  290. 2830  GOSUB 1680
  291. 2840  LOCATE 23,1 : PRINT SPACE$(79);
  292. 2850  LOCATE 23,1
  293. 2860  INPUT "Enter the Mother's Record Number";REPLY$
  294. 2870  IF REPLY$ = "/" THEN 3750
  295. 2880  IF REPLY$ = "" THEN 2910
  296. 2890  T7 = VAL(REPLY$)
  297. 2900  GOSUB 1680
  298. 2910  LOCATE 23,1 : PRINT SPACE$(79);
  299. 2920  LOCATE 23,1
  300. 2930  INPUT "Enter the Person's Birth-date as: dd Mmm yyyy";REPLY$
  301. 2940  IF REPLY$ = "/" THEN 3750
  302. 2950  IF REPLY$ = "" THEN 2980
  303. 2960  T8$ = REPLY$
  304. 2970  GOSUB 1680
  305. 2980  LOCATE 23,1 : PRINT SPACE$(79);
  306. 2990  LOCATE 23,1
  307. 3000  INPUT "Enter the Person's Birth-city";REPLY$
  308. 3010  IF REPLY$ = "/" THEN 3750
  309. 3020  IF REPLY$ = "" THEN 3050
  310. 3030  T9$ = REPLY$
  311. 3040  GOSUB 1680
  312. 3050  LOCATE 23,1 : PRINT SPACE$(79);
  313. 3060  LOCATE 23,1
  314. 3070  INPUT "Enter the Person's Birth-county";REPLY$
  315. 3080  IF REPLY$ = "/" THEN 3750
  316. 3090  IF REPLY$ = "" THEN 3120
  317. 3100  T10$ = REPLY$
  318. 3110  GOSUB 1680
  319. 3120  LOCATE 23,1 : PRINT SPACE$(79);
  320. 3130  LOCATE 23,1
  321. 3140  INPUT "Enter the Person's Birth-state or Country";REPLY$
  322. 3150  IF REPLY$ = "/" THEN 3750
  323. 3160  IF REPLY$ = "" THEN 3190
  324. 3170  T11$ = REPLY$
  325. 3180  GOSUB 1680
  326. 3190  LOCATE 23,1 : PRINT SPACE$(79);
  327. 3200  LOCATE 23,1
  328. 3210  INPUT "Enter the Person's Death-date as: dd Mmm yyyy";REPLY$
  329. 3220  IF REPLY$ = "/" THEN 3750
  330. 3230  IF REPLY$ = "" THEN 3260
  331. 3240  T12$ = REPLY$
  332. 3250  GOSUB 1680
  333. 3260  LOCATE 23,1 : PRINT SPACE$(79);
  334. 3270  LOCATE 23,1
  335. 3280  INPUT "Enter the Person's Death-city";REPLY$
  336. 3290  IF REPLY$ = "/" THEN 3750
  337. 3300  IF REPLY$ = "" THEN 3330
  338. 3310  T13$ = REPLY$
  339. 3320  GOSUB 1680
  340. 3330  LOCATE 23,1 : PRINT SPACE$(79);
  341. 3340  LOCATE 23,1
  342. 3350  INPUT "Enter the Person's Death-county";REPLY$
  343. 3360  IF REPLY$ = "/" THEN 3750
  344. 3370  IF REPLY$ = "" THEN 3400
  345. 3380  T14$ = REPLY$
  346. 3390  GOSUB 1680
  347. 3400  LOCATE 23,1 : PRINT SPACE$(79);
  348. 3410  LOCATE 23,1
  349. 3420  INPUT "Enter the Person's Death-state or Country";REPLY$
  350. 3430  IF REPLY$ = "/" THEN 3750
  351. 3440  IF REPLY$ = "" THEN 3470
  352. 3450  T15$ = REPLY$
  353. 3460  GOSUB 1680
  354. 3470  LOCATE 23,1 : PRINT SPACE$(79);
  355. 3480  LOCATE 23,1
  356. 3490  INPUT "Enter the Person's Burial-date as: dd Mmm yyyy";REPLY$
  357. 3500  IF REPLY$ = "/" THEN 3750
  358. 3510  IF REPLY$ = "" THEN 3540
  359. 3520  T16$ = REPLY$
  360. 3530  GOSUB 1680
  361. 3540  LOCATE 23,1 : PRINT SPACE$(79);
  362. 3550  LOCATE 23,1
  363. 3560  INPUT "Enter the Person's Burial-city";REPLY$
  364. 3570  IF REPLY$ = "/" THEN 3750
  365. 3580  IF REPLY$ = "" THEN 3610
  366. 3590  T17$ = REPLY$
  367. 3600  GOSUB 1680
  368. 3610  LOCATE 23,1 : PRINT SPACE$(79);
  369. 3620  LOCATE 23,1
  370. 3630  INPUT "Enter the Person's Burial-county";REPLY$
  371. 3640  IF REPLY$ = "/" THEN 3750
  372. 3650  IF REPLY$ = "" THEN 3680
  373. 3660  T18$ = REPLY$
  374. 3670  GOSUB 1680
  375. 3680  LOCATE 23,1 : PRINT SPACE$(79);
  376. 3690  LOCATE 23,1
  377. 3700  INPUT "Enter the Person's Burial-state or Country";REPLY$
  378. 3710  IF REPLY$ = "/" THEN 3750
  379. 3720  IF REPLY$ = "" THEN 3750
  380. 3730  T19$ = REPLY$
  381. 3740  GOSUB 1680
  382. 3750  REM Input is complete, now see if user wants to save the data
  383. 3760  LOCATE 24,1 : PRINT SPACE$(79);
  384. 3770  LOCATE 23,1 : PRINT SPACE$(79);
  385. 3780  LOCATE 23,1
  386. 3790  INPUT "Type s (save), m (more), or f (forget)";REPLY$
  387. 3800  IF LEFT$(REPLY$,1) = "m" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 2380
  388. 3810  IF LEFT$(REPLY$,1) = "f" THEN CLS : GOTO 1040
  389. 3820  IF LEFT$(REPLY$,1) = "s" THEN LOCATE 22,1 : PRINT SPACE$(79); : GOTO 3850
  390. 3830  LOCATE 22,1 : PRINT "Error in reply";
  391. 3840  GOTO 3770
  392. 3850  REM Routine to SAVE the newly updated record
  393. 3860  LSET F1$  = MKS$(T1)
  394. 3870  LSET F2$  = T2$
  395. 3880  LSET F3$  = T3$
  396. 3890  LSET F4$  = LEFT$(T4$,1)
  397. 3900  LSET F5$  = MKS$(T5)
  398. 3910  LSET F6$  = MKS$(T6)
  399. 3920  LSET F7$  = MKS$(T7)
  400. 3930  LSET F8$  = T8$
  401. 3940  LSET F9$  = T9$
  402. 3950  LSET F10$  = T10$
  403. 3960  LSET F11$  = T11$
  404. 3970  LSET F12$  = T12$
  405. 3980  LSET F13$  = T13$
  406. 3990  LSET F14$  = T14$
  407. 4000  LSET F15$  = T15$
  408. 4010  LSET F16$  = T16$
  409. 4020  LSET F17$  = T17$
  410. 4030  LSET F18$  = T18$
  411. 4040  LSET F19$  = T19$
  412. 4050  PUT #1, REC.NO
  413. 4060  CLS
  414. 4070  GOTO 1040
  415. 4080  CLOSE #1
  416. 4090  CLS : LOCATE 21,1
  417. 4100  PRINT "End of Program"
  418. 4110  RUN "a:menu"
  419. 5000  REM Blank out a negative record
  420. 5020  T2$ = ""
  421. 5030  T3$ = ""
  422. 5040  T4$ = ""
  423. 5050  T5 = 0
  424. 5060  T6 = 0
  425. 5070  T7 = 0
  426. 5080  T8$ = ""
  427. 5090  T9$ = ""
  428. 5100  T10$ = ""
  429. 5110  T11$ = ""
  430. 5120  T12$ = ""
  431. 5130  T13$ = ""
  432. 5140  T14$ = ""
  433. 5150  T15$ = ""
  434. 5160  T16$ = ""
  435. 5170  T17$ = ""
  436. 5180  T18$ = ""
  437. 5190  T19$ = ""
  438. 5200  RETURN
  439.